---
title: "corrplot绘制相关性热图"
author: "果仁菌"
date: "8/20/2020"
output: html_document
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
#install.packages("corrplot")
library(corrplot)
```


```{r ppr}
# 载入数据
data(mtcars)
# 计算相关性
cor.M <- cor(mtcars)
```

```{r plot1}
## corrplot绘制相关性热图（default）
corrplot(cor.M)
```

```{r plot2}
## 使用 type 参数设置 热图形式：upper lower full(default)
corrplot(cor.M,type = "upper")
```

```{r plot3}
## 使用 method 参数设置 热图单元格内元素展示形式：circle(default) square pie
corrplot(cor.M,type = "upper",method = "square")
## plz try "pie"
```

```{r plot4}
## 使用 order 参数设置色块排列顺序逻辑：hclust、original(default)、FPC、AOE
corrplot(cor.M,type = "upper",method = "square",order = "hclust")
```

```{r plot5}
## 使用 col 参数设置渐变色：使用colorRampPalette()函数进行设置：红白三色渐变
col1 <- colorRampPalette(c("red","white"))
corrplot(cor.M,type = "upper",method = "square", order = "hclust",col = col1(3))
```

```{r plot6}
## 使用 col 参数设置渐变色：使用colorRampPalette()函数进行设置：红绿十色渐变
col1 <- colorRampPalette(c("red","green"))
corrplot(cor.M,type = "upper",method = "square", order = "hclust", col = col1(10))
```

```{r plot7}
## 使用 col 参数设置渐变色：使用colorRampPalette()函数进行设置：红蓝十色渐变
## 使用 hclust.method 参数配合 addrect 参数 及 order = "hclust" (此处设置必须为 "hclust" )使用
## 参数 rect.col 设置下图方框颜色
col1 <- colorRampPalette(c("red","blue"))
corrplot(cor.M,method = "square", col = col1(10), 
         order = "hclust",
         hclust.method = "ward.D2", 
         addrect = 4,
         rect.col = "red")
```

```{r plot8}
## 使用 addgrid.color 设定边线颜色（default 是灰色 NULL）
corrplot(cor.M,type = "upper",method = "square", 
         addgrid.col = "white")
```

```{r plot9}
## 使用 cl.pos 设定渐变色条legend的位置 位置：n（没有legend） r（right） b（below）
corrplot(cor.M,type = "upper",method = "square",
         cl.pos = "n")
```
         

```{r plot10}
res1 <- cor.mtest(mtcars, conf.level = 0.95)
res2 <- cor.mtest(mtcars, conf.level = 0.99)
corrplot(cor.M,type = "upper",
         p.mat = res1$p, sig.level = 0.5, addg = "grey20")
```

```{r plot11, eval=FALSE, include=FALSE}
corrplot(cor.M,type = "upper",add = F)
library(dplyr)

set.seed(20190420)
n <- ncol(mtcars)
grp <- c('Group01', 'Group02', 'Group03') # 分组名称
sp <- c(rep(0.0008, 6), rep(0.007, 2), rep(0.03, 3), rep(0.13, 22)) # P值
gx <- c(-4.5, -2.5, 1) # 分组的X坐标
gy <- c(n-1, n-5, 2.5) # 分组的Y坐标
df <- data.frame(
  grp = rep(grp, each = n), # 分组名称，每个重复n次
  gx = rep(gx, each = n), # 组X坐标，每个重复n次
  gy = rep(gy, each = n), # 组Y坐标，每个重复n次
  x = rep(0:(n - 1) - 0.5, 3), # 变量连接点X坐标
  y = rep(n:1, 3), # 变量连接点Y坐标
  p = sample(sp), # 对人工生成p值进行随机抽样
  r = sample(c(rep(0.8, 4), rep(0.31, 7), rep(0.12, 22))) 
)

df <- df %>% #此处使用的是dplyr包中的管道符将df传递给下一个分析函数作为输入值。

  mutate( #此处使用的plyr包的mutate函数在原有数据框的基础上，对已有数据进行汇总，并且添加至新的列，以便于下游绘制不同p值和不同r值得线条颜色和线条粗细使用。
    lcol = ifelse(p <= 0.001, '#1B9E77', NA), #使用ifelse函数根据p值和r值对线条的粗细和颜色进行因子化处理，并且添加至新的列便于下游分析使用。
    # p值小于0.001时，颜色为绿色，下面依次类推
    lcol = ifelse(p > 0.001 & p <= 0.01, '#88419D', lcol),
    lcol = ifelse(p > 0.01 & p <= 0.05, '#A6D854', lcol),
    lcol = ifelse(p > 0.05, '#B3B3B3', lcol),
    lwd = ifelse(r >= 0.5, 14, NA),
    # r >= 0.5 时，线性宽度为14，下面依次类推
    lwd = ifelse(r >= 0.25 & r < 0.5, 7, lwd),
    lwd = ifelse(r < 0.25, 1, lwd)
  )

corrplot(cor.M,type = "upper",add = F)
segments(df$gx, df$gy, df$x, df$y, lty = 'solid', lwd = df$lwd, 
         col = df$lcol, xpd = TRUE)
points(df$gx, df$gy, pch = 24, col = 'blue', bg = 'blue', cex = 3, xpd = TRUE) 
# 组标记点，绘制每个组的标记点。df$gx, 
text(df$gx - 0.5, df$gy, labels = df$grp, adj = c(1, 0.5), cex = 1.5, xpd = TRUE)
```

```{r plot13}
labels01 <- c('<= 0.001','0.001 < x <= 0.01','0.01 < x <= 0.05','> 0.05')
labels02 <- c('>= 0.5', '0.25 - 0.5', '< 0.25')
labels_x <- rep(-6, 4)
labels_y <- seq(4.6, 2.6, length.out = 4)
text(-6.5, 5.2, 'P-value', adj = c(0, 0.5), cex = 1.2, font = 2, xpd = TRUE)
text(labels_x, labels_y, labels01, adj = c(0, 0.5), cex = 1.2, xpd = TRUE)
points(labels_x - 0.5, labels_y, pch = 20, col = c('#1B9E77', '#88419D','#A6D854', '#B3B3B3'),
       cex = 3, xpd = TRUE)
lines_x <- c(-6.5, -3, 0.5)
lines_y <- rep(1.2, 3)
text(-6.5, 1.9, "Mantel's r", adj = c(0, 0.5), cex = 1.2, font = 2, xpd = TRUE)
text(lines_x + 1.5, lines_y, labels02, adj = c(0, 0.5), cex = 1.2, xpd = TRUE)
segments(lines_x, lines_y, lines_x + 1, lines_y, lwd = c(14, 7, 2.5), lty = 'solid', 
         col = '#B3B3B3', xpd = TRUE)

## 图例框框，这一部分就是绘制图注信息外面框，本质就是一条线段一条线段的拼接起来的，严格按照坐标信息标记即可。
segments(-6.9, 5.6, -2.8, 5.6, lty = 'solid', lwd = 1.2, 
         col = 'grey50', xpd = TRUE)
segments(-2.8, 5.6, -2.8, 1.8, lty = 'solid', lwd = 1.2, 
         col = 'grey50', xpd = TRUE)
segments(-2.8, 1.8, 3.6, 1.8, lty = 'solid', lwd = 1.2, 
         col = 'grey50', xpd = TRUE)
segments(3.6, 1.8, 3.6, 0.7, lty = 'solid', lwd = 1.2, 
         col = 'grey50', xpd = TRUE)
segments(3.6, 0.7, -6.9, 0.7, lty = 'solid', lwd = 1.2, 
         col = 'grey50', xpd = TRUE)
segments(-6.9, 0.7, -6.9, 5.6, lty = 'solid', lwd = 1.2, 
         col = 'grey50', xpd = TRUE)
```
